home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / UserCode / canon.tcl next >
Text File  |  1994-03-08  |  4KB  |  164 lines
  1. # FILE: canon.tcl
  2. #
  3. # LAST UPDATED: 12/07/92 6:37:34 AM
  4. #
  5. # This file contains the following TCL procedure(s):
  6. #
  7. #     canon    -- forces identifiers to canonical form
  8.  
  9. # SYNOPSIS:
  10. # 
  11. #    Canonize identifiers
  12. # 
  13. # DESCRIPTION:
  14. # 
  15. #    Searches & replaces identifiers with new/corrected spelling.
  16. #    May be used to force language keywords to a particular alphabetic
  17. #    case.  Simplifies ensuring case consistency.
  18. #    
  19. #    Advantages of using this procedure over simple search/replace
  20. #    are:
  21. #    
  22. #    A. Defaults to word boundary replacements
  23. #    B. Batch operation
  24. #    C. Forces alphabetic case
  25. # 
  26. # INSTRUCTIONS:
  27. # 
  28. #    Simply:
  29. #    1. Create several lines with the old and new words.  List may
  30. #       start with # treated as a comment.  Example:
  31. # 
  32. #        oldName newName
  33. # 
  34. #    2. Select lines containing old and new words.
  35. #    3. Invoking canon will change EVERY occurence.  Example:
  36. # 
  37. #        newName newName
  38. # 
  39. #    4. If you want the original text back, it is saved in the named clipboard
  40. #       called "canon-text"
  41. # 
  42. #    Options:
  43. # 
  44. #        -a = any occurence of oldName (not restricted to word boundaries)
  45. #        -c = case insensitive
  46. #        -r = use regular expressions
  47. # 
  48. #    If any line in the list has a single word only, then the canonization
  49. #    forces any case insensitive version of that word to the specific case.
  50.  
  51. # COPYRIGHT:
  52. #
  53. #    Copyright © 1992 by David C. Black
  54. #    All rights reserved.
  55. #
  56. #    Redistribution and use in source and binary forms are permitted
  57. #    provided that the above copyright notice and this paragraph are
  58. #    duplicated in all such forms and that any documentation,
  59. #    advertising materials, and other materials related to such
  60. #    distribution and use acknowledge that the software was developed
  61. #    by David C. Black.
  62. #
  63. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  64. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  65. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  66. #
  67. ################################################################################
  68.  
  69. # AUTHOR
  70. #
  71. #    David C. Black
  72. #    Internet: black@mpd.tandem.com (preferred)
  73. #    GEnie:    D.C.Black
  74. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  75. #
  76. ################################################################################
  77.  
  78. # HISTORY
  79. #                  
  80. # modified who rev reason
  81. # -------- --- --- ------
  82. # 12/03/92 DCB 1.0 Original
  83. ################################################################################
  84.  
  85. proc canon {args} {
  86.     global searchStr
  87.     global replaceStr
  88.     global ignoreCase
  89.     global regExpr
  90.     global forward
  91.     global ignoreCase
  92.     global matchWords
  93.     shadowVar regExpr
  94.     shadowVar forward
  95.     shadowVar ignoreCase
  96.     shadowVar matchWords
  97.     saveVars
  98.     if {[getPos] == [selEnd]} {
  99.         alertnote "Nothing selected"
  100.         return
  101.     }
  102.     watchCursor
  103.     set regExpr 0
  104.     set forward 1
  105.     set ignoreCase 0
  106.     set matchWords 1
  107.     foreach arg $args {
  108.         case $arg {
  109.             {-a} {
  110.                 set matchWords 0
  111.             }
  112.             {-c} {
  113.                 set ignoreCase 1
  114.             }
  115.             {-r} {
  116.                 set regExpr 1
  117.             }
  118.         }
  119.     }
  120.  
  121.     # Get the canonical text list
  122.     beginningLineSelect
  123.     endLineSelect
  124.     set text [getSelect]
  125.     clear
  126.     
  127.     # Save copy
  128.     global clipBoards
  129.     enableMenuItem Misc "pasteNamedClipboard" on
  130.     set clipBoards(canon-text) $text
  131.  
  132.     set lines [split $text "\r"]
  133.  
  134.     # Split the text list into a proper TCL list
  135.     foreach line $lines {
  136.         regsub "^#" $line "" line
  137.         set line [string trim $line]
  138.         regsub "\[ \t\]+" $line " " line
  139.         set bullet [split $line]
  140.         case [llength $bullet] {
  141.         {2} {
  142.             lappend bullet $ignoreCase
  143.             lappend ammo $bullet
  144.         }
  145.         {1} {
  146.             lappend ammo [list $bullet $bullet 1]
  147.         }
  148.         }
  149.     }
  150.     
  151.     # Do the work
  152.     foreach pair $ammo {
  153.         set searchStr [lindex $pair 0]
  154.         set replaceStr [lindex $pair 1]
  155.         set ignoreCase $ignoreCase
  156.         goto 0
  157.         searchRall
  158.     }
  159.     restoreVars
  160. }
  161. #endproc canon
  162.  
  163. ################################################################################
  164.